home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / AddToLabelDataBase.pdrx < prev    next >
Text File  |  1992-06-15  |  4KB  |  140 lines
  1. /*
  2. @N
  3.  
  4. This Genie allows you to add an entry to an existing label database
  5. */
  6. msg = PDSetup.rexx(2,0)
  7. units = getclip(pds_units)
  8. if msg ~= 1 then exit_msg(msg)
  9. cr = '0a'x
  10.  
  11. pgdir = ReadINI.rexx("FNT", "S:PDraw.ini")
  12.  
  13. if pgdir = '' then
  14. do
  15.     pgdir = pdm_GetFileName("Please find the PDraw/data directory", "", "")
  16.     if pgdir = '' then exit_msg()
  17.     pgdir = SplitFileName.rexx(pgdir)
  18. end
  19.  
  20. if right(pgdir, 1) = ":" then pgdir = pgdir'Data/'
  21. else pgdir = pgdir'/Data/'
  22.  
  23. dlist = getdirlist.rexx(pgdir, ".db")
  24. if dlist = '' then exit_msg("Unable to find database files! Please reinstall")
  25.  
  26. obj = pdm_SelFirstObj()
  27. if obj ~= 0 then
  28. do
  29.     size    = pdm_GetObjVisSize(obj)
  30.     width    = pdm_ConvertUnits(1, units, word(size, 1))
  31.     height    = pdm_ConvertUnits(1, units, word(size, 2))
  32. end
  33. else
  34. do
  35.     width    = ""
  36.     height    = ""
  37. end
  38.  
  39. do 
  40.  
  41.     labeltype = pdm_Inform(3,"Would you  like to add a Dot Matrix label or a Laser Label?", "Cancel", "Dot Matrix", "Laser")
  42.  
  43.     if labeltype = 0 then exit_msg()
  44.  
  45.     if labeltype = 1 then
  46.     do
  47.  
  48.         form = "Part Number"cr"Label Type"cr"Label Width:"width || cr"Label Height:"height || cr"Num. Columns"cr"Carrier Width"cr"Horizontal Pitch"cr"Vertical Pitch"
  49.  
  50.         form = pdm_GetForm("Enter Label Specifications..", 20, form)
  51.         if form = '' then exit_msg()
  52.  
  53.         parse var form pnum '0a'x type '0a'x lwid '0a'x lheight '0a'x cols '0a'x cwidth '0a'x hpitch '0a'x vpitch
  54.  
  55.         if ~(datatype(lheight, n) & datatype(lwid, n) & datatype(cols, n) & datatype(cwidth,n) & datatype(hpitch, n) & datatype(vpitch,n)) then exit_msg("Invalid Entry")
  56.  
  57.         if units ~= 1 then
  58.         do
  59.             lheight    = pdm_ConvertUnits(units, 1, lheight)
  60.             lwid    = pdm_ConvertUnits(units, 1, lwid)
  61.             cwidth    = pdm_ConvertUnits(units, 1, cwidth)
  62.             hpitch    = pdm_ConvertUnits(units, 1, hpitch)
  63.             vpitch    = pdm_ConvertUnits(units, 1, vpitch)
  64.         end
  65.  
  66.         line = pnum';'type';'lheight';'lwid';'cols';'cwidth';'hpitch';'vpitch';'
  67.  
  68.         filename = pdm_SelectFromList("Select label database..", 25,5,0,dlist)
  69.         if filename = '' then exit_msg()
  70.         filename = pgdir || filename".db"
  71.  
  72.         if ~open(file, filename, r) then 
  73.             exit_msg("Unable to open file: "filename)
  74.  
  75.         fline = readln(file)
  76.         if pos('MATRIX', fline) = 0 then
  77.             exit_msg("This is not a Dot Matrix Label Database..")
  78.  
  79.         call seek(file, 0, e)
  80.         call writeln(file, line)
  81.         call close(file)
  82.         call pdm_Inform(1,"Finished..",)
  83.     end
  84.     else
  85.     do
  86.  
  87.         form = "Part Number"cr"Label Type"cr"Label Width:"width || cr"Label Height:"height cr"Num. Columns"cr"Num. Rows"cr"Top Margin"cr"Side Margin"cr"Horizontal Pitch"cr"Vertical Pitch"
  88.  
  89.         form = pdm_GetForm("Enter Label Specifications..", 20, form)
  90.         if form = '' then exit_msg()
  91.  
  92.         parse var form pnum '0a'x type '0a'x lwid '0a'x lheight '0a'x cols '0a'x rows '0a'x tmarg '0a'x smarg '0a'x hpitch '0a'x vpitch
  93.  
  94.         if ~(datatype(lheight, n) & datatype(lwid, n) & datatype(cols, n) & datatype(rows,n) & datatype(tmarg, n) & datatype(smarg, n) & datatype(hpitch, n) & datatype(vpitch, n)) then
  95.             exit_msg("Invalid entry")
  96.  
  97.         if hpitch < lwid then 
  98.             exit_msg("Horizontal pitch must be greater than or equal to label width")
  99.         if vpitch < lheight then 
  100.             exit_msg("Vertical pitch must be greater than or equal to label height")
  101.  
  102.         if units ~= 1 then
  103.         do
  104.             lheight    = pdm_ConvertUnits(units, 1, lheight)
  105.             lwid    = pdm_ConvertUnits(units, 1, lwid)
  106.             tmarg    = pdm_ConvertUnits(units, 1, tmarg)
  107.             smarg    = pdm_ConvertUnits(units, 1, smarg)
  108.             hpitch    = pdm_ConvertUnits(units, 1, hpitch)
  109.             vpitch    = pdm_ConvertUnits(units, 1, vpitch)
  110.         end
  111.  
  112.         line = pnum';'type';'lheight';'lwid';'cols';'rows';'tmarg';'smarg';'hpitch';'vpitch';'
  113.  
  114.         filename = pdm_SelectFromList("Select label database..", 25,5,0,dlist)
  115.         if filename = '' then exit_msg()
  116.         filename = pgdir || filename".db"
  117.         
  118.         if ~open(file, filename, r) then exit_msg("Unable to open file: "filename)
  119.         fline = readln(file)
  120.         if pos('LASER', fline) = 0 then exit_msg("This is not a Laser Label Database..")
  121.         call seek(file, 0, e)
  122.         call writeln(file, line)
  123.         call close(file)
  124.  
  125.         call pdm_Inform(1,"Finished..",)
  126.     end
  127. end
  128.  
  129. exit_msg()
  130.  
  131. exit_msg: procedure expose units
  132. do
  133.     parse arg message
  134.  
  135.     if message ~= '' then call pdm_Inform(1,message,)
  136.     call pdm_SetUnits(units)
  137.     exit
  138. end
  139.  
  140.